perm filename MATCH.NEW[1,JRA] blob
sn#031521 filedate 1973-03-22 generic text, type T, neo UTF8
00010 (DE TREE(L)
00020 (COND((ATOM(CDR (ANCESTOR L)))(LIST L))
00030 (T(NCONC(LIST L)(TREE(CAR(ANCESTOR L)))(TREE(CDR(ANCESTOR L)))))) )
00040
00100 (DE MATCHER(L TREE)
00200 (PROG NIL
00300 A(COND((NULL L)(RETURN NIL))
00400 ((MEMQ (CAR L) TREE)(RETURN T)))
00500 (SETQ L(CDR L))(GO A)))
00600
00700 (DF *CLM(L)(*CL(CAR L) CLAUSES))
00800 (DE OCNP(P C)
00900 (PROG (Z )
01000 (COND((ALLPOS C)(RETURN NIL)))
01100 (SETQ Z(NEGL C))
01200 (COND((ATOM P)(RETURN(OCNPL P Z))))
01210 (RETURN(OCNP1 P Z)) ))
01220 (DE OCNP1(P Z)(PROG(Z1)
01300 B(SETQ Z1(CDAR Z))
01400 (COND((NOT(EQ(CAR P)(CAR Z1)))NIL)
01500 ((UNI(CDR P)(CDR Z1) NIL)(RETURN T)))
01600 (SETQ Z(CDR Z))
01700 (COND(Z(GO B)))(RETURN NIL)
01800 ))
01900
02000 (DE OCNPL(P C)
02100 (PROG NIL
02200 A(COND((EQ P(CADAR C))(RETURN T)))
02300 (SETQ C(CDR C))(COND (C(GO A)))(RETURN NIL) ))
02400
02500 (DE OCPP(P C)
02600 (PROG (Z)
02700 (COND((ALLNEG C)(RETURN (OCNP P C))))
02800 (SETQ Z(NEGL C))
02900 (SETQ C(CDR C))
03000 (COND((ATOM P)(RETURN (OCPPL P C Z))))
03100 B(COND((NOT (EQ(CAR P)(CAAR C)))NIL)
03200 ((UNI(CDR P)(CDAR C)NIL)(RETURN T)))
03300 (SETQ C(CDR C))
03400 (COND((NOT (EQ C Z))(GO B))((NULL C)(RETURN NIL)))
03450
03500 (RETURN(OCNP1 P Z)) ))
03600
03700 (DE OCPPL (P C Z)
03800 (PROG NIL
03900 A(COND((EQ P(CAAR C))(RETURN T)))
04000 (SETQ C(CDR C))
04100 (COND((NOT (EQ C Z))(GO A))((NULL C)(RETURN NIL)))
04200 (RETURN (OCNPL P Z)) ))
00100
00200
00300 (DEFPROP VARIT1
00400 (LAMBDA(Z)
00500 (PROG (Z1 Z2 Z3)
00600 (SETQ Z3 Z)
00700 M1 (SETQ Z2 (CAR Z))
00800 (COND ((VAR Z2)
00900 (COND ((SETQ Z1 (ASSOC Z2 BL)) (RPLACA Z (CDR Z1)))
01000 (T (SETQ BL (CONS (CONS Z2 (SETQ NO (ADD1 NO))) BL)) (RPLACA Z NO))))
01100 ((CONST Z2) NIL)
01200 (T (VARIT1 (CDR Z2))))
01300 (SETQ Z (CDR Z))
01400 (COND (Z (GO M1)))
01500 (RETURN Z3)))
01600 EXPR)
01700 (DF VARIT(L)
01800 (PROG(BL)
01900 (COND((ATOM(CAR L))(RETURN(SETQ NO(ADD1 NO))))((EQUAL(CADAR L) @(%))(RETURN(CAAR L))))
02000 (COND((CDAR L)(VARIT1(CDAR L))))
02100 (RETURN (CAR L)) ))
02200
02300
02400 (DEFPROP OCTM
02500 (LAMBDA(X Y)
02600 (PROG (Z)
02700 (COND((ATOM X)NIL)((AND(ATOM(CAR X))(NULL(CDR X)))(RETURN(OCFNL(CAR X)Y))))
02800 (SETQ Y(CDR Y))
02850 (SETQ X(LIST X))
02900 B (SETQ Z (TERMS1 (LIST (COND ((NEG (CAR Y)) (CDAR Y)) (T (CAR Y)))) 64))
03000 A (COND ((UNI X (CAR Z) NIL) (RETURN T)))
03100 (SETQ Z (CDR Z))
03200 (COND (Z (GO A)))
03300 (SETQ Y (CDR Y))
03400 (COND (Y (GO B)))
03500 (RETURN NIL)))
03600 EXPR)
03700
03800 (DEFPROP OCFNL
03900 (LAMBDA(X Y)
04000 (PROG NIL
04100 (SETQ Y (CDR Y))
04200 A (COND ((COND ((NEG (CAR Y)) (OCR X (CDDAR Y))) (T (OCR X (CDAR Y)))) (RETURN T)))
04300 (SETQ Y (CDR Y))
04400 (COND (Y (GO A)))
04500 (RETURN NIL)))
04600 EXPR)
04700
04800
04900 (DEFPROP OCR
05000 (LAMBDA(X Y)
05100 (COND ((NULL Y) NIL)
05200 ((VAR (CAR Y)) (OCR X (CDR Y)))
05300 ((CONST (CAR Y)) (COND ((EQ (CAAR Y) X) T) (T (OCR X (CDR Y)))))
05400 ((EQ X (CAAR Y)) T)
05500 ((OCR X (CDAR Y)) T)
05600 (T (OCR X (CDR Y)))))
05700 EXPR)